perm filename GEO[AM,DBL] blob
sn#211584 filedate 1976-04-16 generic text, type T, neo UTF8
(FILECREATED "10-APR-76 20:42:58" <LENAT>GEO.;3 29924
previous date: " 7-APR-76 20:32:22" <LENAT>GEO.;2)
(LISPXPRINT (QUOTE GEOCOMS)
T T)
[RPAQQ GEOCOMS (GEOFNS GEOCONS [COMS * (LIST (CONS (QUOTE IFPROP)
(CONS (QUOTE ALL)
GEOCONS]
(P (MAPC GEOCONS (QUOTE NEW-CON))
(MAPC (QUOTE (INV-ADD FACTOR ADD-FACTOR INV-MULTIPLY))
(QUOTE KILLB)))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML]
(RPAQQ GEOFNS (ALWAYS-DEFINED ALWAYS-UNIQUE ANG ANG-EQ INTERCEPT LIN MEAS NUM-BETWEEN POINTP PT RDIST SLOPE SQ TRI))
(RPAQQ GEOCONS (ANGLE ANGLE-EQUAL BETWEEN COLLINEAR COLLINEAR-STRUC DISTANCE DRAW-ANGLE DRAW-LINE DRAW-TRIANGLE FUNC
LINE LINE-EQUAL MEASURE-ANGLE MEASURE-TRIANGLE POINT RIGHT-ANGLE STRAIGHT-ANGLE TRIANGLE
TRIANGLE-EQUAL))
(PUTPROPS ANGLE GENL (OBJECT ORD-OBJ)
WORTH (700 500 0 300)
DEFN [(TYPE NONRECURSIVE OPAQUE (MATCH BA1 WITH ('ANG &@POINTP &@POINTP &@POINTP]
IN-RAN-OF (DRAW-ANGLE)
UP (ANY-STRUC)
EXS ((ANG (PT 30 3)
(PT 1 21)
(PT 1 3))
(ANG (PT 13 5)
(PT 26 29)
(PT 30 21))
(ANG (PT 19 23)
(PT 19 6)
(PT 30 4))
(ANG (PT 30 29)
(PT 28 19)
(PT 3 26))
(ANG (PT 14 18)
(PT 14 30)
(PT 25 24))
(ANG (PT 21 15)
(PT 23 24)
(PT 7 29))
(ANG (PT 12 3)
(PT 17 6)
(PT 20 30))
(ANG (PT 26 22)
(PT 25 3)
(PT 30 20))
(ANG (PT 19 20)
(PT 11 12)
(PT 18 29))
(ANG (PT 18 11)
(PT 30 7)
(PT 2 18))
(ANG (PT 2 19)
(PT 2 27)
(PT 10 21))
(ANG (PT 23 25)
(PT 8 7)
(PT 30 14))
(ANG (PT 9 5)
(PT 28 29)
(PT 15 4))
(ANG (PT 2 1)
(PT 16 24)
(PT 1 23))
(ANG (PT 1 20)
(PT 28 30)
(PT 15 10))
(ANG (PT 11 10)
(PT 19 20)
(PT 10 12))
(ANG (PT 16 28)
(PT 1 16)
(PT 23 29))
(ANG (PT 16 5)
(PT 11 12)
(PT 21 4))
(ANG (PT 10 4)
(PT 4 30)
(PT 28 24))
(ANG (PT 11 5)
(PT 10 11)
(PT 12 19))
(ANG (PT 0 22)
(PT 24 5)
(PT 30 0))
(ANG (PT 0 5)
(PT 8 10)
(PT 28 28))
(ANG (PT 15 29)
(PT 30 21)
(PT 21 25))
(ANG (PT 30 30)
(PT 25 21)
(PT 18 23))
(ANG (PT 10 28)
(PT 29 15)
(PT 8 10))
(ANG (PT 0 30)
(PT 1 0)
(PT 10 13))
(ANG (PT 11 28)
(PT 3 18)
(PT 9 27))
(ANG (PT 20 0)
(PT 29 1)
(PT 23 30))
(ANG (PT 19 15)
(PT 6 8)
(PT 14 1))
(ANG (PT 24 30)
(PT 20 16)
(PT 12 19))
(ANG (PT 4 0)
(PT 0 0)
(PT 0 5))
(ANG (PT 0 0)
(PT 3 3)
(PT 12 12)))
EXS-BDY ((ANG (PT 0 0)
(PT 1 1)
(PT 10 10))
(ANG (PT 1 0)
(PT 0 0)
(PT 0 5)))
EXS-NOT-BDY ((VECTOR (PT 1 3)
(PT 2 5)
(PT 33 0)))
EXS-NOT (T NIL (ANG)
(BAG))
IN-DOM-OF (ANGLE-EQUAL)
SPEC (RIGHT-ANGLE STRAIGHT-ANGLE)
FEX (7 (ANG (PT 0 0)
(PT 10 10)
(PT 10 0))
(ANG (PT 20 0)
(PT 3 3)
(PT 3 20))
(ANG (PT 0 5)
(PT 0 0)
(PT 1 0))
(ANG (PT 1 0)
(PT 0 0)
(PT 0 5))
(ANG (PT 0 0)
(PT 1 1)
(PT 10 10))
(ANG (PT 0 0)
(PT 1 1)
(PT 10 10))
(ANG (PT 1 0)
(PT 0 0)
(PT 0 5)))
UP-NOT (ACTIVE))
(PUTPROPS ANGLE-EQUAL WORTH (400 200 100 60)
ALGS [(TYPE NONRECURSIVE OPAQUE (AND (APPLYB (QUOTE ANGLE)
(QUOTE DEFN)
BA1)
(APPLYB (QUOTE ANGLE)
(QUOTE DEFN)
BA2)
(EQUAL (APPLYB (QUOTE MEASURE-ANGLE)
(QUOTE ALGS)
BA1)
(APPLYB (QUOTE MEASURE-ANGLE)
(QUOTE ALGS)
BA2))
(EQUAL (VERTEX BA1)
(VERTEX BA2))
(EQUAL (ANGLE-ORIENTATION BA1)
(ANGLE-ORIENTATION BA2]
D-R ((ANGLE ANGLE TRUTH-VAL))
GUP (PREDICATE)
DEFN [(TYPE NONRECURSIVE OPAQUE (AND (APPLYB (QUOTE ANGLE)
(QUOTE DEFN)
BA1)
(APPLYB (QUOTE ANGLE)
(QUOTE DEFN)
BA2)
(EQUAL (APPLYB (QUOTE MEASURE-ANGLE)
(QUOTE ALGS)
BA1)
(APPLYB (QUOTE MEASURE-ANGLE)
(QUOTE ALGS)
BA2))
(EQUAL (VERTEX BA1)
(VERTEX BA2))
(EQUAL (ANGLE-ORIENTATION BA1)
(ANGLE-ORIENTATION BA2]
UP (PREDICATE ACTIVE)
EXS-NOT-BDY [((ANG (PT 30 30)
(PT 25 21)
(PT 18 23))
(ANG (PT 14 18)
(PT 14 30)
(PT 25 24)))
(CLASS (ANG (PT 19 15)
(PT 6 8)
(PT 14 1)))
((ANG (PT 30 30)
(PT 25 21)
(PT 18 23))
(ANG (PT 26 22)
(PT 25 3)
(PT 30 20)))
((ANG (PT 30 3)
(PT 1 21)
(PT 1 3))
(ANG (PT 2 19)
(PT 2 27)
(PT 10 21)))
((ANG (PT 11 10)
(PT 19 20)
(PT 10 12))
(ANG (PT 30 29)
(PT 28 19)
(PT 3 26)))
((ANG (PT 0 5)
(PT 8 10)
(PT 28 28))
(ANG (PT 19 23)
(PT 19 6)
(PT 30 4])
(PUTPROPS BETWEEN WORTH (300 200 400 60)
ALGS ((TYPE NONRECURSIVE OPAQUE (AND (APPLYB (QUOTE COLLINEAR)
(QUOTE DEFN)
BA1 BA2 BA3)
(NUM-BETWEEN (CADDR BA2)
(CADDR BA1)
(CADDR BA3))
(NUM-BETWEEN (CADR BA2)
(CADR BA1)
(CADR BA3))
T)))
D-R ((POINT POINT POINT TRUTH-VAL))
DEFN ((TYPE NONRECURSIVE OPAQUE (AND (APPLYB (QUOTE COLLINEAR)
(QUOTE DEFN)
BA1 BA2 BA3)
(NUM-BETWEEN (CADDR BA2)
(CADDR BA1)
(CADDR BA3))
(NUM-BETWEEN (CADR BA2)
(CADR BA1)
(CADR BA3))
T)))
GENL (COLLINEAR))
(PUTPROPS COLLINEAR WORTH (300 200 400 60)
ALGS [(TYPE QUASIRECURSIVE REDUCING-TO LINE-EQUAL (AND (POINTP BA1)
(POINTP BA2)
(POINTP BA3)
(APPLYB (QUOTE LINE-EQUAL)
(QUOTE ALGS)
(APPLYB (QUOTE DRAW-LINE)
(QUOTE ALGS)
BA1 BA2)
(APPLYB (QUOTE DRAW-LINE)
(QUOTE ALGS)
BA1 BA3]
SPEC (BETWEEN)
D-R ((POINT POINT POINT TRUTH-VAL))
GUP (PREDICATE)
DEFN [(TYPE QUASIRECURSIVE REDUCING-TO LINE-EQUAL (AND (POINTP BA1)
(POINTP BA2)
(POINTP BA3)
(APPLYB (QUOTE LINE-EQUAL)
(QUOTE DEFN)
(APPLYB (QUOTE DRAW-LINE)
(QUOTE ALGS)
BA1 BA2)
(APPLYB (QUOTE DRAW-LINE)
(QUOTE ALGS)
BA1 BA3]
UP (PREDICATE ACTIVE))
(PUTPROPS COLLINEAR-STRUC GENL (OBJECT)
WORTH (700 500 0 350 0 0 0 0 0 0 0 0)
DEFN [(TYPE NONRECURSIVE OPAQUE (COND ((MATCH BA1 WITH (& &@POINTP &@POINTP))
T)
((MATCH BA1 WITH (& &@POINTP &@POINTP &@POINTP))
(APPLYB (QUOTE COLLINEAR)
(QUOTE DEFN)
(CADR BA1)
(CADDR BA1)
(CADDDR BA1)))
((MATCH BA1 WITH (& &@POINTP &@POINTP &@POINTP
&@POINTP))
(AND (APPLYB (QUOTE COLLINEAR)
(QUOTE DEFN)
(CADR BA1)
(CADDR BA1)
(CADDDR BA1))
(APPLYB (QUOTE COLLINEAR)
(QUOTE DEFN)
(CADDR BA1)
(CADDDR BA1)
(CADDDDR BA1]
ALGS [(TYPE NONRECURSIVE OPAQUE (COND ((MATCH BA1 WITH (& &@POINTP &@POINTP))
T)
((MATCH BA1 WITH (& &@POINTP &@POINTP &@POINTP))
(APPLYB (QUOTE COLLINEAR)
(QUOTE DEFN)
(CADR BA1)
(CADDR BA1)
(CADDDR BA1)))
((MATCH BA1 WITH (& &@POINTP &@POINTP &@POINTP
&@POINTP))
(AND (APPLYB (QUOTE COLLINEAR)
(QUOTE DEFN)
(CADR BA1)
(CADDR BA1)
(CADDDR BA1))
(APPLYB (QUOTE COLLINEAR)
(QUOTE DEFN)
(CADDR BA1)
(CADDDR BA1)
(CADDDDR BA1]
UP (ANY-STRUC)
UP-NOT (ACTIVE)
TIES ((STRAIGHT-ANGLE (EXS CONTAINMENT)))
FEX (8 (ANG (PT 0 0)
(PT 1 1)
(PT 10 10))))
(PUTPROPS DISTANCE WORTH (100 100 0 400)
ALGS [(TYPE NONRECURSIVE OPAQUE QUICK
(AND (POINTP BA1)
(POINTP BA2)
(FIX (PLUS .5 (SQRT (PLUS (SQ (DIFFERENCE (CADR BA1)
(CADR BA2)))
(SQ (DIFFERENCE (CADDR BA1)
(CADDR BA2]
D-R ((POINT POINT NUMBER))
GUP (FUNC)
UP (FUNC OPERATION ACTIVE)
DEFN [(TYPE NONRECURSIVE OPAQUE QUICK
(AND (POINTP BA1)
(POINTP BA2)
(EQUAL BA3 (FIX (PLUS .5 (SQRT (PLUS (SQ (DIFFERENCE (CADR BA1)
(CADR BA2)))
(SQ (DIFFERENCE (CADDR BA1)
(CADDR BA2]
EXS (((PT 0 0)
(PT 3 0)
3)
((PT 3 0)
(PT 0 0)
3)
((PT 3 3)
(PT 6 7)
5))
EXS-BDY (((PT 0 0)
(PT 0 0)
0)
((PT 11 6)
(PT 11 6)
0)))
(PUTPROPS DRAW-ANGLE WORTH (300 100 0 50)
ALGS [(TYPE NONRECURSIVE OPAQUE QUICK (AND (POINTP BA1)
(POINTP BA2)
(POINTP BA3)
(NOT (EQUAL BA3 BA2))
(NOT (EQUAL BA1 BA2))
(CONS (QUOTE ANG)
(SORT (LIST BA1 BA2 BA3)
(QUOTE SORD]
D-R ((POINT POINT POINT ANGLE))
GUP (FUNC)
UP (FUNC OPERATION ACTIVE)
DEFN [(TYPE NONRECURSIVE OPAQUE QUICK (AND BA1 BA2 BA3 BA4 (EQUAL BA4 (APPLYB (QUOTE DRAW-ANGLE)
(QUOTE ALGS)
BA1 BA2 BA3])
(PUTPROPS DRAW-LINE WORTH (300 100 0 50)
ALGS [(TYPE NONRECURSIVE OPAQUE QUICK (AND (POINTP BA1)
(POINTP BA2)
(NOT (EQUAL BA1 BA2))
(CONS (QUOTE LIN)
(SORT (LIST BA1 BA2)
(QUOTE SORD]
D-R ((POINT POINT LINE))
GUP (FUNC)
UP (FUNC OPERATION ACTIVE)
DEFN [(TYPE NONRECURSIVE OPAQUE QUICK (AND BA1 BA2 BA3 (EQUAL BA3 (APPLYB (QUOTE DRAW-LINE)
(QUOTE ALGS)
BA1 BA2])
(PUTPROPS DRAW-TRIANGLE WORTH (300 100 0 50)
ALGS [(TYPE NONRECURSIVE OPAQUE QUICK (AND (POINTP BA1)
(POINTP BA2)
(POINTP BA3)
(NOT (EQUAL BA3 BA2))
(NOT (EQUAL BA1 BA3))
(NOT (EQUAL BA1 BA2))
(CONS (QUOTE TRI)
(SORT (LIST BA1 BA2 BA3)
(QUOTE SORD]
D-R ((POINT POINT POINT TRIANGLE))
GUP (FUNC)
UP (FUNC OPERATION ACTIVE)
DEFN [(TYPE NONRECURSIVE OPAQUE QUICK (AND BA1 BA2 BA3 BA4 (EQUAL BA4 (APPLYB (QUOTE
DRAW-TRIANGLE)
(QUOTE ALGS)
BA1 BA2 BA3])
(PUTPROPS FUNC GENL (OPERATION)
WORTH (800 900 200 0)
EXS (PROJ1 PROJ2 REAR REV-ORD-PAIR STRUCTURE-DELETE STRUCTURE-DIFF STRUCTURE-INSERT
STRUCTURE-INTERSECT BAG-STRUC-DIFF BAG-STRUC-JOIN FINAL FIRST MAP-JOIN MAP-REPLACE
MAP-REPLACE2 SET-STRUC-INTERSECT ADD CROSS-PRODUCT DIVIDE INV-SQUARE MAXI MINI MULTIPLY
SUBTRACT DISTANCE DRAW-LINE MEASURE-ANGLE DRAW-ANGLE DRAW-TRIANGLE MEASURE-TRIANGLE)
DEFN [(TYPE NONRECURSIVE OPAQUE (OR (FMEMB BA1 (ACEX FUNC))
(AND (ALWAYS-DEFINED BA1)
(ALWAYS-UNIQUE BA1])
(PUTPROPS LINE GENL (OBJECT)
WORTH (700 500 0 300)
DEFN [(TYPE NONRECURSIVE OPAQUE (MATCH BA1 WITH ('LIN &@POINTP &@POINTP]
IN-RAN-OF (DRAW-LINE)
UP (ANY-STRUC)
EXS ((LIN (PT 4 17)
(PT 2 25))
(LIN (PT 2 34)
(PT 6 5))
(LIN (PT 2 36)
(PT 12 24))
(LIN (PT 19 3)
(PT 37 16))
(LIN (PT 34 10)
(PT 11 31))
(LIN (PT 16 39)
(PT 14 7))
(LIN (PT 10 12)
(PT 34 24))
(LIN (PT 23 9)
(PT 30 7))
(LIN (PT 26 27)
(PT 22 24))
(LIN (PT 37 22)
(PT 40 12))
(LIN (PT 6 37)
(PT 34 15))
(LIN (PT 17 26)
(PT 6 3))
(LIN (PT 3 21)
(PT 39 5))
(LIN (PT 40 32)
(PT 28 18))
(LIN (PT 23 10)
(PT 29 8))
(LIN (PT 22 33)
(PT 1 38))
(LIN (PT 6 32)
(PT 31 19))
(LIN (PT 2 34)
(PT 8 11))
(LIN (PT 20 9)
(PT 8 22))
(LIN (PT 33 5)
(PT 39 31))
(LIN (PT 22 6)
(PT 21 20))
(LIN (PT 25 26)
(PT 13 9))
(LIN (PT 10 25)
(PT 9 0))
(LIN (PT 17 21)
(PT 1 7))
(LIN (PT 16 22)
(PT 38 9))
(LIN (PT 35 12)
(PT 18 8))
(LIN (PT 35 4)
(PT 13 40))
(LIN (PT 40 38)
(PT 36 19))
(LIN (PT 35 31)
(PT 37 22))
(LIN (PT 2 12)
(PT 25 18))
(LIN (PT 4 33)
(PT 19 12))
(LIN (PT 8 4)
(PT 15 40))
(LIN (PT 8 5)
(PT 16 6))
(LIN (PT 22 17)
(PT 27 10))
(LIN (PT 8 28)
(PT 39 4))
(LIN (PT 35 22)
(PT 31 0))
(LIN (PT 25 27)
(PT 17 18))
(LIN (PT 2 33)
(PT 6 0))
(LIN (PT 36 36)
(PT 10 27))
(LIN (PT 10 10)
(PT 31 11))
(LIN (PT 35 20)
(PT 30 30))
(LIN (PT 7 26)
(PT 32 29))
(LIN (PT 21 33)
(PT 40 38))
(LIN (PT 38 24)
(PT 7 29))
(LIN (PT 32 7)
(PT 0 4))
(LIN (PT 4 34)
(PT 23 23))
(LIN (PT 39 17)
(PT 9 32))
(LIN (PT 7 37)
(PT 39 18))
(LIN (PT 9 39)
(PT 12 3))
(LIN (PT 38 16)
(PT 40 14)))
EXS-BDY ((LIN (PT 0 0)
(PT 0 0)))
EXS-NOT-BDY ((PAIR (PT 10 10)
(PT 10 10))
(LIN (PT 10 10)))
EXS-NOT (T NIL (LIN)
(BAG))
IN-DOM-OF (LINE-EQUAL)
UP-NOT (ACTIVE)
FEX (8 (LIN (PT 0 0)
(PT 10 10))
(LIN (PT 10 0)
(PT 10 0))
(LIN (PT 0 0)
(PT 0 0))))
(PUTPROPS LINE-EQUAL WORTH (600 200 100 60)
ALGS ((TYPE NONRECURSIVE OPAQUE (AND (APPLYB (QUOTE LINE)
(QUOTE DEFN)
BA1)
(APPLYB (QUOTE LINE)
(QUOTE DEFN)
BA2)
(EQUAL (SLOPE BA1)
(SLOPE BA2))
(EQUAL (INTERCEPT BA1)
(INTERCEPT BA2))
T)))
D-R ((LINE LINE TRUTH-VAL))
GUP (PREDICATE)
DEFN ((TYPE NONRECURSIVE OPAQUE (AND (APPLYB (QUOTE LINE)
(QUOTE DEFN)
BA1)
(APPLYB (QUOTE LINE)
(QUOTE DEFN)
BA2)
(EQUAL (SLOPE BA1)
(SLOPE BA2))
(EQUAL (INTERCEPT BA1)
(INTERCEPT BA2))
T)))
UP (PREDICATE ACTIVE)
GENL (GENL-LINE-EQUAL GENL-LINE-EQUAL-1))
(PUTPROPS MEASURE-ANGLE WORTH (600 100 0 600)
ALGS [(TYPE NONRECURSIVE OPAQUE QUICK (AND (APPLYB (QUOTE ANGLE)
(QUOTE DEFN)
BA1)
(NOT (EQUAL (CADR BA1)
(CADDR BA1)))
(NOT (EQUAL (CADDR BA1)
(CADDDR BA1)))
(FIX (PLUS .5 (MEAS (CADR BA1)
(CADDR BA1)
(CADDDR BA1]
D-R ((ANGLE NUMBER))
GUP (FUNC)
UP (FUNC OPERATION ACTIVE)
DEFN [(TYPE NONRECURSIVE OPAQUE QUICK (AND (APPLYB (QUOTE ANGLE)
(QUOTE DEFN)
BA1)
(NUMBERP BA2)
(NOT (EQUAL (CADR BA1)
(CADDR BA1)))
(NOT (EQUAL (CADDR BA1)
(CADDDR BA1)))
(EQUAL BA2 (FIX (PLUS .5 (MEAS (CADR BA1)
(CADDR BA1)
(CADDDR BA1])
(PUTPROPS MEASURE-TRIANGLE WORTH (600 100 0 600)
DEFN [(TYPE NONRECURSIVE OPAQUE QUICK
(AND (APPLYB (QUOTE TRIANGLE)
(QUOTE DEFN)
BA1)
(APPLYB (QUOTE BAG-OF-NUMBERS)
(QUOTE DEFN)
BA2)
(EQUAL BA2 (CONS (QUOTE BAG)
(SORT (LIST (APPLYB (QUOTE DISTANCE)
(QUOTE ALGS)
(CADR BA1)
(CADDR BA1))
(APPLYB (QUOTE DISTANCE)
(QUOTE ALGS)
(CADR BA1)
(CADDDR BA1))
(APPLYB (QUOTE DISTANCE)
(QUOTE ALGS)
(CADDDR BA1)
(CADDR BA1]
D-R ((TRIANGLE BAG-OF-NUMBERS))
GUP (FUNC)
UP (FUNC OPERATION ACTIVE)
ALGS [(TYPE NONRECURSIVE OPAQUE QUICK (AND (APPLYB (QUOTE TRIANGLE)
(QUOTE DEFN)
BA1)
(CONS (QUOTE BAG)
(SORT (LIST (APPLYB (QUOTE DISTANCE)
(QUOTE ALGS)
(CADR BA1)
(CADDR BA1))
(APPLYB (QUOTE DISTANCE)
(QUOTE ALGS)
(CADR BA1)
(CADDDR BA1))
(APPLYB (QUOTE DISTANCE)
(QUOTE ALGS)
(CADDDR BA1)
(CADDR BA1]
UP-NOT (PREDICATE INVERTED-OP)
EXS (((TRI (PT 20 2)
(PT 2 16)
(PT 8 5))
(BAG 12 13 23))
((TRI (PT 10 11)
(PT 10 14)
(PT 14 17))
(BAG 3 5 7))
((TRI (PT 7 0)
(PT 2 5)
(PT 18 11))
(BAG 7 16 17))
((TRI (PT 14 2)
(PT 7 2)
(PT 3 15))
(BAG 7 14 17))
((TRI (PT 15 6)
(PT 14 8)
(PT 10 19))
(BAG 2 12 14))
((TRI (PT 17 7)
(PT 6 9)
(PT 6 0))
(BAG 9 11 13))
((TRI (PT 15 4)
(PT 13 0)
(PT 16 17))
(BAG 4 13 17))
((TRI (PT 13 7)
(PT 5 10)
(PT 3 4))
(BAG 6 9 10))
((TRI (PT 2 2)
(PT 18 13)
(PT 0 18))
(BAG 16 19 19))
((TRI (PT 3 10)
(PT 12 11)
(PT 2 10))
(BAG 1 9 10))
((TRI (PT 20 6)
(PT 3 1)
(PT 1 8))
(BAG 7 18 19))
((TRI (PT 16 10)
(PT 6 3)
(PT 1 3))
(BAG 5 12 17)))
FEX (18 ((TRI (PT 20 2)
(PT 2 16)
(PT 8 5))
(BAG 12 13 23))
((TRI (PT 10 11)
(PT 10 14)
(PT 14 17))
(BAG 3 5 7))
((TRI (PT 7 0)
(PT 2 5)
(PT 18 11))
(BAG 7 16 17))
((TRI (PT 14 2)
(PT 7 2)
(PT 3 15))
(BAG 7 14 17))
((TRI (PT 15 6)
(PT 14 8)
(PT 10 19))
(BAG 2 12 14))
((TRI (PT 17 7)
(PT 6 9)
(PT 6 0))
(BAG 9 11 13))
((TRI (PT 15 4)
(PT 13 0)
(PT 16 17))
(BAG 4 13 17))
((TRI (PT 13 7)
(PT 5 10)
(PT 3 4))
(BAG 6 9 10))
((TRI (PT 2 2)
(PT 18 13)
(PT 0 18))
(BAG 16 19 19))
((TRI (PT 3 10)
(PT 12 11)
(PT 2 10))
(BAG 1 9 10))
((TRI (PT 20 6)
(PT 3 1)
(PT 1 8))
(BAG 7 18 19))
((TRI (PT 16 10)
(PT 6 3)
(PT 1 3))
(BAG 5 12 17))))
(PUTPROPS POINT CLISPISPROP (point)
GENL (OBJECT)
IN-DOM-OF (DISTANCE DRAW-LINE COLLINEAR BETWEEN MIDPOINT MEASURE-ANGLE)
WORTH (700 500 0 300)
DEFN ((TYPE NONRECURSIVE OPAQUE (POINTP BA1)))
IN-RAN-OF (MIDPOINT VERTEX)
UP (ANY-STRUC)
EXS ((PT 0 0)
(PT 10 10)
(PT 0 10)
(PT 10 0)
(PT 0 20)
(PT 30 30))
EXS-BDY ((PT 0 0))
EXS-NOT-BDY ((PAIR 10 10)
(PT 10))
EXS-NOT (T NIL (PT)
(BAG))
UP-NOT (ACTIVE)
FEX (8 (PT 0 0)
(PT 10 10)
(PT 0 10)
(PT 10 0)
(PT 0 20)
(PT 30 30)
(PT 0 0)))
(PUTPROPS RIGHT-ANGLE GENL (ANGLE)
WORTH (700 500 0 350)
DEFN ((TYPE QUASIRECURSIVE REDUCING-TO MEASURE-ANGLE (APPLYB (QUOTE MEASURE-ANGLE)
(QUOTE DEFN)
BA1 90)))
UP-NOT (ACTIVE)
FEX (6 (ANG (PT 1 0)
(PT 0 0)
(PT 0 5))))
(PUTPROPS STRAIGHT-ANGLE GENL (ANGLE)
WORTH (700 500 0 350)
DEFN ((TYPE QUASIRECURSIVE REDUCING-TO MEASURE-ANGLE (APPLYB (QUOTE MEASURE-ANGLE)
(QUOTE DEFN)
BA1 180)))
UP-NOT (ACTIVE PREDICATE)
FEX (8 (ANG (PT 0 0)
(PT 1 1)
(PT 10 10)))
TIES ((COLLINEAR-STRUC (EXS INCLUSION))
(NON-EMPTY-STRUC (EXS INCLUSION))
(STRAIGHT-ANGLE is a specialization of NON-EMPTY-STRUC)
(STRAIGHT-ANGLE is a specialization of COLLINEAR-STRUC)))
(PUTPROPS TRIANGLE GENL (OBJECT UNORD-OBJ)
WORTH (700 500 0 300)
DEFN [(TYPE NONRECURSIVE OPAQUE (MATCH BA1 WITH ('TRI &@POINTP &@POINTP &@POINTP]
IN-RAN-OF (DRAW-TRIANGLE)
UP (ANY-STRUC)
EXS ((TRI (PT 18 5)
(PT 37 29)
(PT 6 19))
(TRI (PT 19 11)
(PT 3 29)
(PT 8 24))
(TRI (PT 37 22)
(PT 0 12)
(PT 16 11))
(TRI (PT 30 17)
(PT 39 22)
(PT 13 24))
(TRI (PT 23 9)
(PT 27 1)
(PT 2 14))
(TRI (PT 28 31)
(PT 40 24)
(PT 20 1))
(TRI (PT 0 7)
(PT 11 14)
(PT 4 10))
(TRI (PT 34 15)
(PT 18 31)
(PT 21 7))
(TRI (PT 11 13)
(PT 38 37)
(PT 23 0))
(TRI (PT 18 19)
(PT 9 5)
(PT 20 13))
(TRI (PT 13 10)
(PT 9 28)
(PT 1 10))
(TRI (PT 18 40)
(PT 27 21)
(PT 24 32))
(TRI (PT 15 5)
(PT 15 6)
(PT 14 12))
(TRI (PT 19 14)
(PT 8 15)
(PT 23 31))
(TRI (PT 8 34)
(PT 4 3)
(PT 31 11))
(TRI (PT 34 24)
(PT 27 11)
(PT 13 40))
(TRI (PT 0 35)
(PT 36 5)
(PT 19 14))
(TRI (PT 8 10)
(PT 17 36)
(PT 17 32))
(TRI (PT 16 8)
(PT 26 39)
(PT 36 29))
(TRI (PT 4 15)
(PT 4 16)
(PT 1 19))
(TRI (PT 26 19)
(PT 11 5)
(PT 34 27))
(TRI (PT 26 28)
(PT 25 31)
(PT 22 4))
(TRI (PT 17 0)
(PT 21 23)
(PT 29 4))
(TRI (PT 17 4)
(PT 24 8)
(PT 33 0))
(TRI (PT 39 0)
(PT 30 33)
(PT 8 6))
(TRI (PT 18 16)
(PT 6 22)
(PT 19 29))
(TRI (PT 25 37)
(PT 25 1)
(PT 32 2))
(TRI (PT 34 7)
(PT 6 10)
(PT 10 32))
(TRI (PT 11 0)
(PT 26 28)
(PT 22 31))
(TRI (PT 5 28)
(PT 18 26)
(PT 12 7))
(TRI (PT 1 0)
(PT 1 3)
(PT 4 0))
(TRI (PT 0 0)
(PT 0 4)
(PT 4 0))
(TRI (PT 0 0)
(PT 0 10)
(PT 10 0)))
EXS-BDY ((TRI (PT 0 0)
(PT 1 1)
(PT 10 10))
(TRI (PT 1 0)
(PT 0 0)
(PT 0 5)))
EXS-NOT-BDY ((VECTOR (PT 1 3)
(PT 2 5)
(PT 33 0)))
EXS-NOT (T NIL (TRI)
(BAG))
IN-DOM-OF (TRIANGLE-EQUAL)
UP-NOT (ACTIVE PREDICATE)
FEX (8 (TRI (PT 0 0)
(PT 10 10)
(PT 10 0))
(TRI (PT 20 0)
(PT 3 3)
(PT 3 20))
(TRI (PT 0 0)
(PT 1 1)
(PT 10 10))
(TRI (PT 1 0)
(PT 0 0)
(PT 0 5))))
(PUTPROPS TRIANGLE-EQUAL WORTH (400 200 100 60)
ALGS [[TYPE NONRECURSIVE OPAQUE (AND (APPLYB (QUOTE TRIANGLE)
(QUOTE DEFN)
BA1)
(APPLYB (QUOTE TRIANGLE)
(QUOTE DEFN)
BA2)
(EQUAL (SORT (CDR BA1)
(QUOTE SORD))
(SORT (CDR BA2)
(QUOTE SORD]
[TYPE NONRECURSIVE OPAQUE (AND (APPLYB (QUOTE TRIANGLE)
(QUOTE DEFN)
BA1)
(APPLYB (QUOTE TRIANGLE)
(QUOTE DEFN)
BA2)
(EQUAL (APPLYB (QUOTE MEASURE-TRIANGLE)
(QUOTE ALGS)
BA1)
(APPLYB (QUOTE MEASURE-TRIANGLE)
(QUOTE ALGS)
BA2))
(EQUAL (TRIANGLE-ORIENTATION BA1)
(TRIANGLE-ORIENTATION BA2))
(EQUAL (MEAS3 BA1)
(MEAS3 BA2]
(TYPE NONRECURSIVE OPAQUE (AND (APPLYB (QUOTE TRIANGLE)
(QUOTE DEFN)
BA1)
(APPLYB (QUOTE TRIANGLE)
(QUOTE DEFN)
BA2)
(SORT (CDR BA1))
(SORT (CDR BA2))
(APPLYB (QUOTE LINE-EQUAL)
(QUOTE ALGS)
(SIDE1 BA1)
(SIDE1 BA2))
(APPLYB (QUOTE LINE-EQUAL)
(QUOTE ALGS)
(SIDE2 BA1)
(SIDE2 BA2))
(APPLYB (QUOTE LINE-EQUAL)
(QUOTE ALGS)
(SIDE3 BA1)
(SIDE3 BA2]
D-R ((TRIANGLE TRIANGLE TRUTH-VAL))
GUP (PREDICATE)
DEFN [[TYPE NONRECURSIVE OPAQUE (AND (APPLYB (QUOTE TRIANGLE)
(QUOTE DEFN)
BA1)
(APPLYB (QUOTE TRIANGLE)
(QUOTE DEFN)
BA2)
(EQUAL (SORT (CDR BA1)
(QUOTE SORD))
(SORT (CDR BA2)
(QUOTE SORD]
[TYPE NONRECURSIVE OPAQUE (AND (APPLYB (QUOTE TRIANGLE)
(QUOTE DEFN)
BA1)
(APPLYB (QUOTE TRIANGLE)
(QUOTE DEFN)
BA2)
(EQUAL (APPLYB (QUOTE MEASURE-TRIANGLE)
(QUOTE ALGS)
BA1)
(APPLYB (QUOTE MEASURE-TRIANGLE)
(QUOTE ALGS)
BA2))
(EQUAL (TRIANGLE-ORIENTATION BA1)
(TRIANGLE-ORIENTATION BA2))
(EQUAL (MEAS3 BA1)
(MEAS3 BA2]
(TYPE NONRECURSIVE OPAQUE (AND (APPLYB (QUOTE TRIANGLE)
(QUOTE DEFN)
BA1)
(APPLYB (QUOTE TRIANGLE)
(QUOTE DEFN)
BA2)
(SORT (CDR BA1)
(QUOTE SORD))
(SORT (CDR BA2)
(QUOTE SORD))
(APPLYB (QUOTE LINE-EQUAL)
(QUOTE ALGS)
(SIDE1 BA1)
(SIDE1 BA2))
(APPLYB (QUOTE LINE-EQUAL)
(QUOTE ALGS)
(SIDE2 BA1)
(SIDE2 BA2))
(APPLYB (QUOTE LINE-EQUAL)
(QUOTE ALGS)
(SIDE3 BA1)
(SIDE3 BA2]
UP (PREDICATE ACTIVE)
ENGN "Congruence"
GENL (GENL-TRIANGLE-EQUAL GENL-TRIANGLE-EQUAL-1 GENL-TRIANGLE-EQUAL-2 GENL-TRIANGLE-EQUAL-3
GENL-TRIANGLE-EQUAL-4 GENL-TRIANGLE-EQUAL-5))
(MAPC GEOCONS (QUOTE NEW-CON))
(MAPC (QUOTE (INV-ADD FACTOR ADD-FACTOR INV-MULTIPLY))
(QUOTE KILLB))
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA)
(ADDTOVAR NLAML)
]
(DECLARE: DONTCOPY
(FILEMAP (NIL)))
STOP